prep

load packages

library(tidyverse)
library(lme4)
library(lmerTest)
library(knitr)
library(cowplot)
library(caret)
library(ROCR)

define aesthetics

algorithm = c("#006989", "#FEC601", "#F43C13", "#00A5CF", "#00A878")
instruction = wesanderson::wes_palette("Darjeeling1", 2, "continuous")
craving = wesanderson::wes_palette("Darjeeling1", 3, "continuous")
rating = c("#00A08A", "#F2AD00", "#F98400", "#FF0000")
palette_condition = c("#685369", "#EEAC00", "#C1C3DE")
dc_bw = plot_aes = theme_minimal() +
  theme(legend.position = "top",
        legend.text = element_text(size = 12),
        text = element_text(size = 16, family = "Futura Medium"),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        axis.text = element_text(color = "black"),
        axis.line = element_line(colour = "black"),
        axis.ticks.y = element_blank())

define functions

table_model = function(model_data) {
  model_data %>%
    broom.mixed::tidy(., conf.int = TRUE) %>%
    rename("SE" = std.error,
           "t" = statistic,
           "p" = p.value) %>%
    filter(effect == "fixed") %>%
    select(-group, -effect) %>%
    mutate_at(vars(-contains("term"), -contains("value")), round, 2) %>%
    mutate(term = gsub(":", " x ", term),
           term = gsub("dot_", "", term),
           term = gsub("wave2", " wave (post)", term),
           term = gsub("instructionregulate", "instruction (regulate)", term),
           term = gsub("conditionCognitive", "condition (cognitive)", term),
           term = gsub("conditionReappraisal", "condition (reappraisal)", term),
           term = gsub("conditionBehavioral", "condition (behavioral)", term),
           term = gsub("conditionControl", "condition (control)", term),
           p = ifelse(p < .001, "< .001",
                      ifelse(p == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p)))),
           `b [95% CI]` = sprintf("%.2f [%0.2f, %.2f]", estimate, conf.low, conf.high)) %>%
    select(term, `b [95% CI]`, df, t, p) %>%
    kable()
}

load tidied data

source("load_data.R")

check ratings

Check if wrong buttons were used (i.e., not 5-8)

DEV001 = code normally
DEV011 = code normally
DEV016 = code normally
DEV017 = exclude; can’t tell if they’re missed ratings or incorrect placement of fingers
DEV019 = exclude; can’t tell if they’re missed ratings or incorrect placement of fingers
DEV020 = code normally
DEV022 = code normally
DEV028 = code normally
DEV032 = incorrect placement of fingers; recode runs 1-2 (LOOK INTO WTP)
DEV037 = exclude; technical error?
DEV054 = exclude; technical error?
DEV060 = code normally; task ended early
DEV061 = code normally; task ended early
DEV063 = code normally; task ended early
DEV069 = incorrect placement of fingers in run1
DEV075 = code normally
DEV082 = code normally
DEV083 = code normally

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

subs = data.all %>%
  group_by(subjectID, wave, run, rating) %>%
  summarize(n = n()) %>%
  spread(rating, n) %>%
  mutate(messed = ifelse(is.na(`5`) & !is.na(`<NA>`), "yes", NA)) %>%
  filter(messed == "yes") %>% 
  ungroup() %>% 
  select(subjectID, wave) %>% 
  unique()

data.all %>%
  group_by(subjectID, run, rating) %>%
  summarize(n = n()) %>%
  spread(rating, n) %>%
  mutate(messed = ifelse(is.na(`5`) & !is.na(`<NA>`), "yes", NA)) %>%
  filter(subjectID %in% subs$subjectID)

recode and exclude

Recoding
* DEV069: recode runs1

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

data.ex = data.all %>%
  mutate(rating = ifelse(subjectID == "DEV069" & run == "run1", rating - 1, rating),
         rating = ifelse(subjectID == "DEV069" & run == "run1" & is.na(rating), 8, rating),
         rating = rating - 4) %>%
  group_by(subjectID, wave) %>%
  arrange(subjectID, run) %>%
  mutate(trial = row_number())

load mean intensity values

file_dir = "dotProducts_ROC_wave1/"
file_pattern =  "DEV[0-9]{3}_meanIntensity.txt"
file_list = list.files(file_dir, pattern =  file_pattern)


intensities = data.frame()

for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "meanIntensity" = V3) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    mutate(beta = as.integer(beta),
                           wave = 1), error = function(e) message(file))
  intensities = rbind(intensities, temp)
  rm(temp)
}

file_dir = "dotProducts_ROC_wave2/"
file_list = list.files(file_dir, pattern =  file_pattern)
for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "meanIntensity" = V3) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    mutate(beta = as.integer(beta),
                           wave = 2), error = function(e) message(file))
  intensities = rbind(intensities, temp)
  rm(temp)
}

load dot products

file_dir = "dotProducts_ROC_wave1/"
file_pattern =  "DEV[0-9]{3}_dotProducts.txt"
file_list = list.files(file_dir, pattern =  file_pattern)

dots = data.frame()

for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "map" = V3,
                           "dotProduct" = V4) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    extract(map, "algorithm", "(.*)_.*.nii") %>%
                    mutate(beta = as.integer(beta),
                            wave = 1), error = function(e) message(file))
  dots = rbind(dots, temp)
  rm(temp)
}

file_dir = "dotProducts_ROC_wave2/"
file_list = list.files(file_dir, pattern =  file_pattern)

for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "map" = V3,
                           "dotProduct" = V4) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    extract(map, "algorithm", "(.*)_.*.nii") %>%
                    mutate(beta = as.integer(beta),
                            wave = 2), error = function(e) message(file))
  dots = rbind(dots, temp)
  rm(temp)
}

join intensities and dots

recode trials with extreme intensities as NA

dots.merged = dots %>%
  left_join(., intensities, by = c("subjectID", "wave", "beta")) %>%
  group_by(subjectID, wave, algorithm) %>%
  mutate(rownum = row_number())

# plot original
dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  ggplot(aes(1, meanIntensity)) +
    geom_boxplot()

# assess extreme values and exclude when calculating SDs
dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  arrange(meanIntensity)

dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  arrange(-meanIntensity)

# recode outliers as NA
dots.merged = dots.merged %>%
  ungroup() %>%
  mutate(meanIntensity = ifelse(meanIntensity > 1 | meanIntensity < -1, NA, meanIntensity),
         median = median(meanIntensity, na.rm = TRUE),
         sd3 = 3*sd(meanIntensity, na.rm = TRUE),
         outlier = ifelse(meanIntensity > median + sd3 | meanIntensity < median - sd3, "yes", "no"),
         dotProduct = ifelse(outlier == "yes", NA, dotProduct))
  
# plot after
dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  ggplot(aes(1, meanIntensity)) +
    geom_boxplot()

recode subs

DEV022 = run4 has 8 trials
DEV037 = ???
DEV048 = run4 missing
DEV060 = run1 has 19 trials; couldn’t estimate run1 trial 19, run3 trial 20
DEV061 = run3 has 19 trials; couldn’t estimate run3 trial 19
DEV063 = run2 has 11 trials
DEV081 = run2 missing (run1 was run twice)
DEV082 = run2 has 15 trials; couldn’t estimate run1 trial 19, run1 trial 20

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

trial.numbers = data.frame(subjectID = c(rep("DEV060", 79), rep("DEV061", 79), rep("DEV063", 71), rep("DEV081", 80), rep("DEV082", 75)),
                           wave = 1,
                           rownum = c(1:79, 1:79, 1:71, 1:80, 1:75),
                           trial = c(1:19, 21:80, 1:59, 61:80, 1:31, 41:80, 1:20, 41:80, 21:40, 1:35, 41:80))

dots.check = dots.merged %>%
  group_by(subjectID, wave, algorithm) %>%
  mutate(rownum = row_number()) %>%
  left_join(., trial.numbers, by = c("subjectID", "wave", "rownum")) %>%
  mutate(trial = ifelse(is.na(trial), rownum, trial),
         dotProduct = ifelse(subjectID == "DEV060" & wave == 1 & trial %in% 19:20, NA,
                      ifelse(subjectID == "DEV061" & wave == 1 & trial == 59, NA,
                      ifelse(subjectID == "DEV082" & wave == 1 & trial %in% 19:20, NA, dotProduct)))) %>%
  select(-rownum) #%>%
  #left_join(., striping, by = c("subjectID", "beta")) %>%
  #mutate(dotProduct = ifelse(!is.na(striping), NA, dotProduct))

merge data and exclude subs

Exclusions

MRI motion and data quality exclusions: DEV001, DEV020, DEV032, DEV047, DEV055, DEV064, DEV066
Button box exclusions: DEV017, DEV019, DEV037, DEV054
Run exclusions: DEV029 (run3), DEV037 (run1), DEV042 (run4), DEV067 (run4)

Other
* select only craved trials

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

conditions = read.csv("~/Desktop/dev_conditions.csv")

data_all = left_join(dots.check, data.ex, by = c("subjectID", "wave", "trial")) %>%
  filter(!(subjectID %in% c("DEV001","DEV020","DEV032","DEV047","DEV055","DEV064","DEV066", "DEV017", "DEV019", "DEV037", "DEV054") & wave == 1)) %>%
  filter(!(subjectID == "DEV029" & wave == 1 & run == "run3") & !(subjectID == "DEV037" & wave == 1 & run == "run1") & !(subjectID == "DEV042" & wave == 1 & run == "run4") & !(subjectID == "DEV067" & wave == 1 & run == "run4")) %>%
  ungroup() %>%
  mutate(algorithm = gsub("_signature", "", algorithm),
         wave = as.character(wave)) %>%
  select(-condition) %>%
  left_join(., conditions) %>%
  filter(condition %in% c("Cognitive", "Control")) %>%
  mutate(condition = recode(condition, "Cognitive" = "Reappraisal"),
         wave = as.numeric(recode(wave, "1" = "0", "2" = "1")))

data = data_all %>%
  filter(craving == "craved") %>%
  filter(algorithm == "craving_regulation")

summarize

n participants by wave

data %>%
  select(subjectID, wave) %>%
  unique() %>%
  group_by(wave) %>%
  summarize(n = n())

n trials

data %>%
  filter(algorithm == "craving_regulation") %>%
  group_by(subjectID) %>%
  summarize(n = n()) %>%
  arrange(n)

roc

by wave

# roc curve
perf.df = data %>%
  filter(algorithm == "craving_regulation") %>%
  filter(!is.na(dotProduct) & !is.na(craving)) %>%
  mutate(instruction = ifelse(instruction == "regulate", 1, 0)) %>%
  group_by(wave) %>%
  do({
    wave = .$wave
    pred = prediction(.$dotProduct, .$instruction, label.ordering = NULL)
    perf = performance(pred, measure = "tpr", x.measure = "fpr")
    data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
  })

ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
  geom_line() +
  scale_color_manual(values = algorithm) +
  xlab("false positive rate") +
  ylab("true positive rate")

roc = data %>%
  filter(algorithm == "craving_regulation") %>%
  select(subjectID, trial, instruction, rating, dotProduct) %>%
  mutate(guess.instruction = ifelse(dotProduct > 0, "regulate", "look"),
         guess.rating = ifelse(dotProduct > 0, "low", "high"),
         rating.bin = ifelse(rating >= 3, "high", "low"),
         instruction = as.factor(instruction),
         guess.instruction = as.factor(guess.instruction),
         rating.bin = as.factor(rating.bin),
         guess.rating = as.factor(guess.rating))

confusionMatrix(roc$guess.instruction, roc$instruction)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction look regulate
##   look     3495     1318
##   regulate 2344     4508
##                                                
##                Accuracy : 0.6861               
##                  95% CI : (0.6776, 0.6945)     
##     No Information Rate : 0.5006               
##     P-Value [Acc > NIR] : < 0.00000000000000022
##                                                
##                   Kappa : 0.3723               
##                                                
##  Mcnemar's Test P-Value : < 0.00000000000000022
##                                                
##             Sensitivity : 0.5986               
##             Specificity : 0.7738               
##          Pos Pred Value : 0.7262               
##          Neg Pred Value : 0.6579               
##              Prevalence : 0.5006               
##          Detection Rate : 0.2996               
##    Detection Prevalence : 0.4126               
##       Balanced Accuracy : 0.6862               
##                                                
##        'Positive' Class : look                 
##

#confusionMatrix(roc$guess.rating, roc$rating.bin)

by condition

# roc curve
perf.df = data %>%
  filter(algorithm == "craving_regulation") %>%
  filter(!is.na(dotProduct) & !is.na(craving)) %>%
  mutate(instruction = ifelse(instruction == "regulate", 1, 0)) %>%
  group_by(condition, wave) %>%
  do({
    condition = .$condition
    wave = .$wave
    pred = prediction(.$dotProduct, .$instruction, label.ordering = NULL)
    perf = performance(pred, measure = "tpr", x.measure = "fpr")
    data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
  })

ggplot(perf.df, aes(fpr, tpr, color = condition, linetype = as.factor(wave))) +
  geom_line() +
  scale_color_manual(values = algorithm) +
  xlab("false positive rate") +
  ylab("true positive rate")

roc = data %>%
  filter(algorithm == "craving_regulation") %>%
  select(subjectID, condition, trial, instruction, rating, dotProduct) %>%
  mutate(guess.instruction = ifelse(dotProduct > 0, "regulate", "look"),
         guess.rating = ifelse(dotProduct > 0, "low", "high"),
         rating.bin = ifelse(rating >= 3, "high", "low"),
         instruction = as.factor(instruction),
         guess.instruction = as.factor(guess.instruction),
         rating.bin = as.factor(rating.bin),
         guess.rating = as.factor(guess.rating))

confusionMatrix(filter(roc, condition == "Cognitive")$guess.instruction, filter(roc, condition == "Cognitive")$instruction)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction look regulate
##   look        0        0
##   regulate    0        0
##                                   
##                Accuracy : NaN     
##                  95% CI : (NA, NA)
##     No Information Rate : NA      
##     P-Value [Acc > NIR] : NA      
##                                   
##                   Kappa : NaN     
##                                   
##  Mcnemar's Test P-Value : NA      
##                                   
##             Sensitivity :  NA     
##             Specificity :  NA     
##          Pos Pred Value :  NA     
##          Neg Pred Value :  NA     
##              Prevalence : NaN     
##          Detection Rate : NaN     
##    Detection Prevalence : NaN     
##       Balanced Accuracy :  NA     
##                                   
##        'Positive' Class : look    
##

#confusionMatrix(roc$guess.rating, roc$rating.bin)

MLM

Disaggregate within and between person relationships

dot_between = grand mean centered person average signature expression
dot_within = person-centered signature expression

between = data %>%
  group_by(condition, wave, subjectID, algorithm) %>%
  summarize(dot_between = mean(dotProduct, na.rm = TRUE)) %>%
  ungroup() %>%
  mutate(dot_between = scale(dot_between, center = TRUE, scale = TRUE))

data_diss = data %>%
  group_by(wave, subjectID, algorithm) %>%
  mutate(dot_within = scale(dotProduct, center = TRUE, scale = TRUE)) %>%
  left_join(., between) %>%
  select(subjectID, condition, wave, trial, instruction, rating, dotProduct, dot_within, dot_between)

no brain

craving ~ wave x instruction

the intervention decreased cravings; this effect is slightly weaker when regulating

tidytable

mod_insruction = lmer(rating ~ instruction * wave * condition + (1 + instruction * wave | subjectID),
                  data = data_diss,
                  control = lmerControl(optimizer = "bobyqa"))
table_model(mod_insruction)

term	b [95% CI]	df	t	p
(Intercept)	3.28 [3.17, 3.39]	160.97	59.29	< .001
instruction (regulate)	-0.99 [-1.11, -0.86]	160.12	-15.58	< .001
wave	-0.40 [-0.54, -0.25]	132.78	-5.42	< .001
condition (reappraisal)	0.02 [-0.13, 0.17]	160.96	0.27	.790
instruction (regulate) x wave	0.08 [-0.06, 0.21]	137.67	1.13	.260
instruction (regulate) x condition (reappraisal)	0.00 [-0.17, 0.18]	159.65	0.03	.980
wave x condition (reappraisal)	-0.30 [-0.50, -0.09]	131.48	-2.91	< .001
instruction (regulate) x wave x condition (reappraisal)	0.00 [-0.18, 0.19]	135.81	0.05	.960

plot

look and regulate

ggeffects::ggpredict(mod_insruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(facet == "Control") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  facet_grid(~group) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(1.5, 3.5)) +
  labs(x = "", y = "predicted craving rating\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

ggeffects::ggpredict(mod_insruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  facet_grid(~group) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(1.5, 3.5)) +
  labs(x = "", y = "predicted craving rating\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

#ggsave(p, filename = "~/Desktop/craving.png", width = 5, height = 4, bg = "white")

regulate only

ggeffects::ggpredict(mod_insruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(facet == "Control") %>%
  filter(group == "regulate") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(1.5, 2.5)) +
  labs(x = "", y = "predicted craving rating\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

ggeffects::ggpredict(mod_insruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(group == "regulate") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(1.5, 2.5)) +
  labs(x = "", y = "predicted craving rating\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

#ggsave(p, filename = "~/Desktop/craving.png", width = 5, height = 4, bg = "white")

model summary

summary(mod_insruction)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ instruction * wave * condition + (1 + instruction *  
##     wave | subjectID)
##    Data: data_diss
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 24381.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.8850 -0.6725  0.0340  0.6616  4.0455 
## 
## Random effects:
##  Groups    Name                     Variance Std.Dev. Corr             
##  subjectID (Intercept)              0.2087   0.4568                    
##            instructionregulate      0.2588   0.5088   -0.44            
##            wave                     0.2872   0.5359   -0.13 -0.09      
##            instructionregulate:wave 0.1844   0.4294   -0.07 -0.26 -0.58
##  Residual                           0.4554   0.6749                    
## Number of obs: 11239, groups:  subjectID, 172
## 
## Fixed effects:
##                                                 Estimate Std. Error         df
## (Intercept)                                     3.275897   0.055251 160.973208
## instructionregulate                            -0.987416   0.063371 160.121667
## wave                                           -0.396077   0.073096 132.776290
## conditionReappraisal                            0.020852   0.076469 160.959733
## instructionregulate:wave                        0.075643   0.067232 137.669653
## instructionregulate:conditionReappraisal        0.002379   0.087624 159.651959
## wave:conditionReappraisal                      -0.295051   0.101263 131.482725
## instructionregulate:wave:conditionReappraisal   0.004838   0.092781 135.806163
##                                               t value             Pr(>|t|)    
## (Intercept)                                    59.292 < 0.0000000000000002 ***
## instructionregulate                           -15.581 < 0.0000000000000002 ***
## wave                                           -5.419          0.000000274 ***
## conditionReappraisal                            0.273               0.7854    
## instructionregulate:wave                        1.125               0.2625    
## instructionregulate:conditionReappraisal        0.027               0.9784    
## wave:conditionReappraisal                      -2.914               0.0042 ** 
## instructionregulate:wave:conditionReappraisal   0.052               0.9585    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) instrc wave   cndtnR instr: inst:R wv:cnR
## instrctnrgl -0.474                                          
## wave        -0.238  0.027                                   
## cndtnRpprsl -0.723  0.342  0.172                            
## instrctnrg:  0.074 -0.377 -0.601 -0.054                     
## instrctnr:R  0.343 -0.723 -0.020 -0.477  0.273              
## wv:cndtnRpp  0.172 -0.020 -0.722 -0.230  0.434  0.025       
## instrctn::R -0.054  0.273  0.436  0.071 -0.725 -0.368 -0.604

craving regulation

brain ~ instruction x wave

expression is stronger when regulating

the intervention increased expression when looking and decreased expression when regulating

tidytable

mod_instruction = lmer(dotProduct ~ instruction * wave * condition + (1 + instruction * wave | subjectID),
                  data = data_diss,
                  control = lmerControl(optimizer = "bobyqa"))
table_model(mod_instruction)

term	b [95% CI]	df	t	p
(Intercept)	-2.02 [-2.76, -1.28]	161.88	-5.39	< .001
instruction (regulate)	8.01 [7.00, 9.02]	160.61	15.64	< .001
wave	-0.26 [-1.06, 0.55]	144.66	-0.63	.530
condition (reappraisal)	-0.67 [-1.69, 0.36]	161.70	-1.29	.200
instruction (regulate) x wave	-0.32 [-1.35, 0.70]	138.50	-0.62	.540
instruction (regulate) x condition (reappraisal)	0.96 [-0.44, 2.37]	160.18	1.36	.180
wave x condition (reappraisal)	2.00 [0.89, 3.11]	143.90	3.56	< .001
instruction (regulate) x wave x condition (reappraisal)	-0.81 [-2.23, 0.61]	137.80	-1.13	.260

simple slopes

modelbased::estimate_contrasts(mod_instruction, "wave", at = c("condition", "instruction"))

plot

look and regulate

ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(facet == "Control") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  facet_grid(~group) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(-3.5, 8)) +
  labs(x = "", y = "predicted signature expresison\n") + 
  dc_bw +
  theme(legend.position = c(.8, .2))

ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  facet_grid(~group) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(-3.5, 8)) +
  labs(x = "", y = "predicted signature expresison\n") + 
  dc_bw +
  theme(legend.position = c(.8, .2))

regulate only

p = ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(facet == "Control") %>%
  filter(group == "regulate") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(4, 8)) +
  labs(x = "", y = "predicted signature expresison\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(group == "regulate") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(4, 8)) +
  labs(x = "", y = "predicted signature expresison\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

### model summary

summary(mod_instruction)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: dotProduct ~ instruction * wave * condition + (1 + instruction *  
##     wave | subjectID)
##    Data: data_diss
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 82037.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -6.3323 -0.6079 -0.0014  0.6174  5.6596 
## 
## Random effects:
##  Groups    Name                     Variance Std.Dev. Corr             
##  subjectID (Intercept)               7.749   2.784                     
##            instructionregulate      14.302   3.782    -0.17            
##            wave                      4.438   2.107    -0.42  0.09      
##            instructionregulate:wave  4.637   2.153    -0.04 -0.27 -0.40
##  Residual                           62.219   7.888                     
## Number of obs: 11665, groups:  subjectID, 174
## 
## Fixed effects:
##                                               Estimate Std. Error       df
## (Intercept)                                    -2.0183     0.3747 161.8842
## instructionregulate                             8.0125     0.5123 160.6116
## wave                                           -0.2569     0.4058 144.6620
## conditionReappraisal                           -0.6686     0.5195 161.6993
## instructionregulate:wave                       -0.3216     0.5188 138.5014
## instructionregulate:conditionReappraisal        0.9641     0.7105 160.1824
## wave:conditionReappraisal                       1.9966     0.5610 143.8991
## instructionregulate:wave:conditionReappraisal  -0.8085     0.7171 137.7973
##                                               t value             Pr(>|t|)    
## (Intercept)                                    -5.386           0.00000025 ***
## instructionregulate                            15.639 < 0.0000000000000002 ***
## wave                                           -0.633             0.527732    
## conditionReappraisal                           -1.287             0.199864    
## instructionregulate:wave                       -0.620             0.536366    
## instructionregulate:conditionReappraisal        1.357             0.176730    
## wave:conditionReappraisal                       3.559             0.000505 ***
## instructionregulate:wave:conditionReappraisal  -1.128             0.261463    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) instrc wave   cndtnR instr: inst:R wv:cnR
## instrctnrgl -0.343                                          
## wave        -0.518  0.258                                   
## cndtnRpprsl -0.721  0.247  0.373                            
## instrctnrg:  0.218 -0.455 -0.586 -0.157                     
## instrctnr:R  0.247 -0.721 -0.186 -0.342  0.328              
## wv:cndtnRpp  0.374 -0.187 -0.723 -0.515  0.424  0.258       
## instrctn::R -0.158  0.329  0.424  0.217 -0.723 -0.452 -0.587

craving ~ brain x wave

between-person: average expression isn’t related to craving ratings

within-person: trials with higher than average expression are associated with lower craving ratings

tidy table

mod_craving = lmer(rating ~ dot_between * wave * condition + dot_within * wave * condition +
                     (1 + dot_within * wave | subjectID),
               data = data_diss,
               control = lmerControl(optimizer = "bobyqa"))
table_model(mod_craving)

term	b [95% CI]	df	t	p
(Intercept)	2.79 [2.69, 2.89]	158.16	56.03	< .001
between	0.06 [-0.03, 0.15]	161.73	1.22	.220
wave	-0.37 [-0.49, -0.25]	139.28	-6.19	< .001
condition (reappraisal)	0.01 [-0.13, 0.14]	157.68	0.12	.910
within	-0.25 [-0.30, -0.20]	157.84	-10.43	< .001
between x wave	-0.07 [-0.20, 0.05]	148.73	-1.19	.230
between x condition (reappraisal)	-0.06 [-0.18, 0.06]	158.05	-0.98	.330
wave x condition (reappraisal)	-0.23 [-0.40, -0.06]	143.31	-2.73	.010
wave x within	0.01 [-0.05, 0.07]	141.93	0.32	.750
condition (reappraisal) x within	-0.02 [-0.09, 0.04]	158.13	-0.62	.530
between x wave x condition (reappraisal)	-0.03 [-0.20, 0.14]	148.42	-0.38	.710
wave x condition (reappraisal) x within	0.02 [-0.06, 0.10]	141.11	0.42	.680

plot

by wave

vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_craving, terms = c("dot_between[vals]", "wave", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_craving, terms = c("dot_within[vals]", "wave", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(facet~type) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\npredicted signature expresison", y = "predicted craving rating\n") + 
  dc_bw

by expression

ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_between [-1, 0, 1]", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_within [-1, 0, 1]", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  mutate(x = as.factor(x)) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(facet~type) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted craving rating\n") + 
  dc_bw

model summary

summary(mod_craving)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave * condition + dot_within * wave *  
##     condition + (1 + dot_within * wave | subjectID)
##    Data: data_diss
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 27928.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.2661 -0.6983 -0.0219  0.7017  3.1624 
## 
## Random effects:
##  Groups    Name            Variance Std.Dev. Corr             
##  subjectID (Intercept)     0.16898  0.4111                    
##            dot_within      0.02434  0.1560   -0.03            
##            wave            0.19157  0.4377   -0.35 -0.25      
##            dot_within:wave 0.01940  0.1393   -0.09 -0.09 -0.32
##  Residual                  0.67700  0.8228                    
## Number of obs: 11012, groups:  subjectID, 172
## 
## Fixed effects:
##                                         Estimate Std. Error         df t value
## (Intercept)                             2.787561   0.049753 158.155561  56.028
## dot_between                             0.055752   0.045638 161.730171   1.222
## wave                                   -0.372062   0.060079 139.275686  -6.193
## conditionReappraisal                    0.008137   0.068708 157.678971   0.118
## dot_within                             -0.249208   0.023891 157.844851 -10.431
## dot_between:wave                       -0.074557   0.062453 148.733625  -1.194
## dot_between:conditionReappraisal       -0.061143   0.062616 158.047865  -0.976
## wave:conditionReappraisal              -0.230859   0.084549 143.309508  -2.730
## wave:dot_within                         0.009609   0.029730 141.934213   0.323
## conditionReappraisal:dot_within        -0.020595   0.033063 158.126032  -0.623
## dot_between:wave:conditionReappraisal  -0.031761   0.084656 148.423203  -0.375
## wave:conditionReappraisal:dot_within    0.017293   0.041222 141.111874   0.420
##                                                   Pr(>|t|)    
## (Intercept)                           < 0.0000000000000002 ***
## dot_between                                        0.22363    
## wave                                         0.00000000624 ***
## conditionReappraisal                               0.90587    
## dot_within                            < 0.0000000000000002 ***
## dot_between:wave                                   0.23445    
## dot_between:conditionReappraisal                   0.33032    
## wave:conditionReappraisal                          0.00712 ** 
## wave:dot_within                                    0.74701    
## conditionReappraisal:dot_within                    0.53425    
## dot_between:wave:conditionReappraisal              0.70806    
## wave:conditionReappraisal:dot_within               0.67548    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw wave   cndtnR dt_wth dt_bt: dt_b:R wv:cnR wv:dt_
## dot_between  0.069                                                        
## wave        -0.407  0.021                                                 
## cndtnRpprsl -0.724 -0.050  0.294                                          
## dot_within  -0.020  0.007 -0.141  0.014                                   
## dot_btwn:wv -0.049 -0.462  0.089  0.035 -0.005                            
## dt_btwn:cnR -0.051 -0.729 -0.015  0.065 -0.005  0.336                     
## wv:cndtnRpp  0.289 -0.015 -0.711 -0.398  0.100 -0.064 -0.045              
## wav:dt_wthn -0.045 -0.013 -0.185  0.032 -0.430  0.005  0.010  0.132       
## cndtnRppr:_  0.014 -0.005  0.102 -0.022 -0.723  0.004  0.003 -0.141  0.310
## dt_btwn:w:R  0.036  0.341 -0.066 -0.029  0.004 -0.738 -0.476 -0.032 -0.003
## wv:cndtnR:_  0.032  0.009  0.134 -0.044  0.310 -0.003 -0.006 -0.184 -0.721
##             cndR:_ dt_::R
## dot_between              
## wave                     
## cndtnRpprsl              
## dot_within               
## dot_btwn:wv              
## dt_btwn:cnR              
## wv:cndtnRpp              
## wav:dt_wthn              
## cndtnRppr:_              
## dt_btwn:w:R -0.002       
## wv:cndtnR:_ -0.422  0.001

craving ~ brain x wave x condition

look trials

tidy table

mod_look = lmer(rating ~ dot_between*wave*condition + dot_within*wave*condition +
                            (1 + dot_within * wave | subjectID),
                      data = filter(data_diss, instruction == "look"),
                      control = lmerControl(optimizer = "bobyqa"))
table_model(mod_look)

term	b [95% CI]	df	t	p
(Intercept)	3.27 [3.16, 3.38]	159.25	58.52	< .001
between	0.07 [-0.03, 0.17]	154.24	1.34	.180
wave	-0.41 [-0.56, -0.26]	131.82	-5.51	< .001
condition (reappraisal)	0.01 [-0.14, 0.16]	160.18	0.14	.890
within	-0.03 [-0.08, 0.01]	133.40	-1.36	.180
between x wave	-0.03 [-0.19, 0.13]	134.41	-0.38	.710
between x condition (reappraisal)	-0.05 [-0.19, 0.08]	149.96	-0.75	.450
wave x condition (reappraisal)	-0.25 [-0.46, -0.05]	135.11	-2.41	.020
wave x within	-0.06 [-0.13, 0.02]	139.31	-1.54	.130
condition (reappraisal) x within	-0.00 [-0.07, 0.06]	135.91	-0.10	.920
between x wave x condition (reappraisal)	-0.10 [-0.31, 0.12]	135.43	-0.87	.380
wave x condition (reappraisal) x within	0.05 [-0.05, 0.15]	135.87	1.01	.320

plot

by wave

vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_look, terms = c("dot_between[vals]", "wave", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_look, terms = c("dot_within[vals]", "wave", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(type ~ facet) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\nsignature expresison", y = "predicted craving rating\n") + 
  dc_bw

by expression

ggeffects::ggpredict(mod_look, terms = c("wave", "dot_between [-1, 0, 1]", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_look, terms = c("wave", "dot_within [-1, 0, 1]", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  mutate(x = as.factor(x)) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(type ~ facet) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted craving rating\n") + 
  dc_bw

model summary

summary(mod_look)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave * condition + dot_within * wave *  
##     condition + (1 + dot_within * wave | subjectID)
##    Data: filter(data_diss, instruction == "look")
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 12607.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.5883 -0.6388  0.1014  0.7126  3.2035 
## 
## Random effects:
##  Groups    Name            Variance Std.Dev. Corr             
##  subjectID (Intercept)     0.202014 0.44946                   
##            dot_within      0.003441 0.05866  -0.06            
##            wave            0.269149 0.51880  -0.12  0.42      
##            dot_within:wave 0.017665 0.13291  -0.05 -0.50 -0.09
##  Residual                  0.501422 0.70811                   
## Number of obs: 5513, groups:  subjectID, 172
## 
## Fixed effects:
##                                         Estimate Std. Error         df t value
## (Intercept)                             3.267563   0.055838 159.247178  58.518
## dot_between                             0.067069   0.049977 154.238028   1.342
## wave                                   -0.409724   0.074369 131.817850  -5.509
## conditionReappraisal                    0.010952   0.077485 160.182303   0.141
## dot_within                             -0.031583   0.023273 133.399392  -1.357
## dot_between:wave                       -0.030488   0.080911 134.406575  -0.377
## dot_between:conditionReappraisal       -0.051371   0.068564 149.958852  -0.749
## wave:conditionReappraisal              -0.253971   0.105193 135.106349  -2.414
## wave:dot_within                        -0.057020   0.037078 139.306014  -1.538
## conditionReappraisal:dot_within        -0.003403   0.032579 135.905692  -0.104
## dot_between:wave:conditionReappraisal  -0.095250   0.109159 135.429262  -0.873
## wave:conditionReappraisal:dot_within    0.051785   0.051409 135.866956   1.007
##                                                   Pr(>|t|)    
## (Intercept)                           < 0.0000000000000002 ***
## dot_between                                         0.1816    
## wave                                           0.000000182 ***
## conditionReappraisal                                0.8878    
## dot_within                                          0.1770    
## dot_between:wave                                    0.7069    
## dot_between:conditionReappraisal                    0.4549    
## wave:conditionReappraisal                           0.0171 *  
## wave:dot_within                                     0.1264    
## conditionReappraisal:dot_within                     0.9170    
## dot_between:wave:conditionReappraisal               0.3844    
## wave:conditionReappraisal:dot_within                0.3156    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw wave   cndtnR dt_wth dt_bt: dt_b:R wv:cnR wv:dt_
## dot_between  0.066                                                        
## wave        -0.250  0.045                                                 
## cndtnRpprsl -0.721 -0.047  0.180                                          
## dot_within   0.150  0.027 -0.040 -0.108                                   
## dot_btwn:wv -0.046 -0.305  0.107  0.033 -0.034                            
## dt_btwn:cnR -0.048 -0.729 -0.033  0.067 -0.019  0.223                     
## wv:cndtnRpp  0.177 -0.032 -0.707 -0.248  0.028 -0.076 -0.042              
## wav:dt_wthn -0.123 -0.020  0.165  0.089 -0.632  0.037  0.014 -0.116       
## cndtnRppr:_ -0.107 -0.019  0.029  0.160 -0.714  0.025  0.026 -0.047  0.452
## dt_btwn:w:R  0.034  0.226 -0.080 -0.026  0.025 -0.741 -0.319 -0.043 -0.027
## wv:cndtnR:_  0.089  0.014 -0.119 -0.131  0.456 -0.027 -0.019  0.166 -0.721
##             cndR:_ dt_::R
## dot_between              
## wave                     
## cndtnRpprsl              
## dot_within               
## dot_btwn:wv              
## dt_btwn:cnR              
## wv:cndtnRpp              
## wav:dt_wthn              
## cndtnRppr:_              
## dt_btwn:w:R -0.025       
## wv:cndtnR:_ -0.639  0.027

regulate trials

tidy table

data_reversed = data_diss %>%
  mutate(condition = factor(condition, levels = c("Reappraisal", "Control")))

mod_regulate = lmer(rating ~ dot_between*wave*condition + dot_within*wave*condition +
                            (1 + dot_within + wave | subjectID),
                      data = filter(data_reversed, instruction == "regulate"),
                      control = lmerControl(optimizer = "bobyqa"))
table_model(mod_regulate)

term	b [95% CI]	df	t	p
(Intercept)	2.32 [2.20, 2.44]	162.18	38.61	< .001
between	-0.03 [-0.13, 0.08]	163.73	-0.50	.620
wave	-0.60 [-0.73, -0.48]	168.68	-9.42	< .001
condition (control)	-0.04 [-0.21, 0.13]	163.20	-0.45	.650
within	-0.02 [-0.06, 0.02]	361.70	-0.78	.440
between x wave	-0.07 [-0.20, 0.05]	154.44	-1.14	.260
between x condition (control)	0.03 [-0.12, 0.19]	167.34	0.44	.660
wave x condition (control)	0.29 [0.11, 0.47]	162.27	3.15	< .001
wave x within	0.05 [-0.00, 0.11]	4002.80	1.84	.070
condition (control) x within	0.01 [-0.04, 0.07]	350.92	0.48	.630
between x wave x condition (control)	0.06 [-0.13, 0.24]	157.05	0.62	.540
wave x condition (control) x within	-0.03 [-0.11, 0.05]	3826.31	-0.78	.430

simple slopes

modelbased::estimate_slopes(mod_regulate, "dot_between", at = c("condition", "wave=c(0,1)"))

plot

pre-post change

between-person

modelbased::estimate_contrasts(mod_regulate, "wave=c(1,0)", at = c("condition", "dot_between=seq(-3,3,.2)")) %>%
  data.frame() %>%
  ggplot(aes(x = dot_between, y = Difference)) +
  geom_ribbon(aes(fill = condition, ymin = CI_low, ymax = CI_high), alpha = 0.2) +
  geom_line(aes(colour = condition), size = 2) +
  geom_hline(yintercept = 0, linetype = "dashed") +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  labs(x = "\naverage signature expression", y = "pre-post change in craving\n") +
  dc_bw

within-person

modelbased::estimate_contrasts(mod_regulate, "wave=c(1,0)", at = c("condition", "dot_within")) %>%
  data.frame() %>%
  ggplot(aes(x = dot_within, y = Difference)) +
  geom_ribbon(aes(fill = condition, ymin = CI_low, ymax = CI_high), alpha = 0.2) +
  geom_line(aes(colour = condition), size = 2) +
  geom_hline(yintercept = 0, linetype = "dashed") +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  labs(x = "\nwithin-person signature expresison", y = "pre-post change in craving\n") +
  dc_bw

by wave

vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_regulate, terms = c("dot_between[vals]", "wave", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_regulate, terms = c("dot_within[vals]", "wave", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(type ~ facet) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\nsignature expresison", y = "predicted craving rating\n") + 
  dc_bw

by expression

ggeffects::ggpredict(mod_regulate, terms = c("wave", "dot_between [-1, 0, 1]", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_regulate, terms = c("wave", "dot_within [-1, 0, 1]", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  mutate(x = as.factor(x)) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(type ~ facet) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted craving rating\n") + 
  dc_bw

model summary

summary(mod_regulate)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave * condition + dot_within * wave *  
##     condition + (1 + dot_within + wave | subjectID)
##    Data: filter(data_reversed, instruction == "regulate")
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 11342.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.0936 -0.6846 -0.0424  0.5552  4.3338 
## 
## Random effects:
##  Groups    Name        Variance Std.Dev. Corr       
##  subjectID (Intercept) 0.273414 0.52289             
##            dot_within  0.005269 0.07259  -0.11      
##            wave        0.212454 0.46093  -0.55  0.04
##  Residual              0.399073 0.63172             
## Number of obs: 5499, groups:  subjectID, 172
## 
## Fixed effects:
##                                     Estimate Std. Error         df t value
## (Intercept)                          2.31841    0.06005  162.17513  38.605
## dot_between                         -0.02644    0.05308  163.72856  -0.498
## wave                                -0.60385    0.06411  168.67922  -9.420
## conditionControl                    -0.03963    0.08730  163.20169  -0.454
## dot_within                          -0.01617    0.02085  361.69916  -0.775
## dot_between:wave                    -0.07167    0.06311  154.44025  -1.136
## dot_between:conditionControl         0.03417    0.07834  167.34094   0.436
## wave:conditionControl                0.28784    0.09138  162.26733   3.150
## wave:dot_within                      0.05226    0.02841 4002.80379   1.840
## conditionControl:dot_within          0.01433    0.03003  350.91843   0.477
## dot_between:wave:conditionControl    0.05782    0.09364  157.05349   0.618
## wave:conditionControl:dot_within    -0.03149    0.04016 3826.31204  -0.784
##                                               Pr(>|t|)    
## (Intercept)                       < 0.0000000000000002 ***
## dot_between                                    0.61907    
## wave                              < 0.0000000000000002 ***
## conditionControl                               0.65042    
## dot_within                                     0.43869    
## dot_between:wave                               0.25790    
## dot_between:conditionControl                   0.66326    
## wave:conditionControl                          0.00195 ** 
## wave:dot_within                                0.06591 .  
## conditionControl:dot_within                    0.63352    
## dot_between:wave:conditionControl              0.53778    
## wave:conditionControl:dot_within               0.43303    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw wave   cndtnC dt_wth dt_bt: dt_b:C wv:cnC wv:dt_
## dot_between  0.062                                                        
## wave        -0.542 -0.129                                                 
## condtnCntrl -0.688 -0.042  0.373                                          
## dot_within  -0.181 -0.016  0.147  0.125                                   
## dot_btwn:wv -0.013 -0.585 -0.129  0.009  0.014                            
## dt_btwn:cnC -0.042 -0.678  0.087  0.077  0.011  0.396                     
## wv:cndtnCnt  0.380  0.090 -0.702 -0.556 -0.103  0.090 -0.068              
## wav:dt_wthn  0.106  0.014 -0.212 -0.073 -0.631 -0.020 -0.010  0.149       
## cndtnCntr:_  0.126  0.011 -0.102 -0.178 -0.694 -0.010 -0.017  0.146  0.438
## dt_btwn:w:C  0.009  0.394  0.087 -0.045 -0.010 -0.674 -0.576 -0.004  0.013
## wv:cndtnC:_ -0.075 -0.010  0.150  0.106  0.446  0.014  0.014 -0.207 -0.707
##             cndC:_ dt_::C
## dot_between              
## wave                     
## condtnCntrl              
## dot_within               
## dot_btwn:wv              
## dt_btwn:cnC              
## wv:cndtnCnt              
## wav:dt_wthn              
## cndtnCntr:_              
## dt_btwn:w:C  0.017       
## wv:cndtnC:_ -0.643 -0.026

DEV ROC betaseries

Dani Cosme

2023-07-27

prep

load packages

define aesthetics

define functions

load tidied data

check ratings

recode and exclude

load mean intensity values

load dot products

join intensities and dots

recode subs

merge data and exclude subs

summarize

n participants by wave

n trials

roc

by wave

by condition

MLM

no brain

craving ~ wave x instruction

tidytable

plot

look and regulate

regulate only

model summary

craving regulation

brain ~ instruction x wave

tidytable

simple slopes

plot

look and regulate

regulate only

craving ~ brain x wave

tidy table

plot

by wave

by expression

model summary

craving ~ brain x wave x condition

look trials

tidy table

plot

by wave

by expression

model summary

regulate trials

tidy table

simple slopes

plot

pre-post change

between-person

within-person

by wave

by expression

model summary